home *** CD-ROM | disk | FTP | other *** search
- #include <math.h>
-
- /* Adaptive quadrature routine.
- Called with:
- lft: left endpoint
- rt: right endpoint
- f: pointer to function to integrate
- err: pointer to allowable error
- p1: function value at left endpoint
- p2: function value at center of interval
- p3: function value at right endpoint
-
- Returns
- return value evaluated integral
- err pointer to upper limit of actual error
- */
-
- static double adaptive2 (double lft, double rt, double (*f)(double x), double *err,
- double p1, double p3, double p5)
- {
- double p2, p4; /* Function values at pts 2 & 4. */
- double h; /* Width of this interval. */
- double error; /* Actual error on this interval. */
- double err1, err2; /* Errors of the sub-intervals. */
- double int3, /* Value of the integral with Simpson */
- int5; /* 3- and 5-point approximations. */
-
- h = rt - lft; /* Get the width of the interval. */
- /* Get the 2 approximations to the integral. */
- p2 = (*f)(lft + h/4.0);
- p4 = (*f)(rt - h/4.0);
-
- int3 = h * (p1 + 4.0 * p3 + p5) / 6.0;
- int5 = h * (p1 + 4.0 * p2 + 2.0 * p3 + 4.0 * p4 + p5) / 12.0;
-
- error = fabs (int3 - int5) / 15.0; /* Find the actual error. */
- if (error < *err) /* If within tolerance, */
- {
- *err = error; /* copy the actual error to caller, */
- return (int5); /* return the more accurate approx. */
- }
- else /* Otherwise, */
- {
- err1 = err2 = *err / 2.0; /* integrate the two half-regions, */
- int5 = adaptive2 (lft, lft + h/2.0, f, &err1, p1, p2, p3);
- int5 += adaptive2 (lft + h/2.0, rt, f, &err2, p3, p4, p5);
- *err = err1 + err2; /* sum the real errors, */
- return (int5); /* and return the integral. */
- }
- }
-
- /* Adaptive quadrature interface.
- Called with:
- lft: left endpoint
- rt: right endpoint
- f: pointer to function to integrate
- err: pointer to allowable error
-
- Returns
- return value evaluated integral
- err pointer to upper limit of actual error
- */
- double adaptive (double lft, double rt, double (*f)(double x), double *err)
- {
- double p1, p2, p3; /* Initial function evaluations. */
- double h; /* Width of this interval. */
-
- h = rt - lft; /* Get the width of the interval. */
-
- p1 = (*f)(lft); /* Pre-compute the initial function */
- p2 = (*f)(lft + h/2.0); /* values. */
- p3 = (*f)(rt);
-
- /* Call adaptive2 to do the real work. */
- return (adaptive2 (lft, rt, f, err, p1, p2, p3));
- }
-
-